home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 4 / CU Amiga Magazine's Super CD-ROM 04 (1996)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1996-11].iso / magazine / psion / misc / wt276.lzx / worktime.opl < prev    next >
Text File  |  2004-02-22  |  40KB  |  1,719 lines
  1.  
  2. Rem Worktime
  3. Rem ¸1994-1996 Erik Johansen, ej@it.dtu.dk
  4.  
  5. Rem TODO: Real print mode/not to a file.
  6.  
  7. Rem Keeps track of projects, meetings and work hours and other
  8. Rem timing tasks. Time how long you spend on meetings, on transport, at dinners.
  9.  
  10. Rem See bottom for user definable project keys
  11.  
  12. APP WorkTime
  13.     TYPE $1003
  14.     EXT "WTM"
  15.     ICON "\PIC\Worktime.pic"
  16. ENDA
  17.  
  18. PROC Start:
  19.     global sad&,maxday&,d1970&,d2038&
  20.     global off&,cur&,exists%,lastpro%
  21.     global gcy%,gcmax%,mode$(1)
  22.     global Tsetup&(10),Psetup&(10),Setup$(10,63)
  23.     global PCtext$(50,255),PCdiff&(50),LastPC%
  24.     global bbegin&,bend&,bnorm&,btext$(63)
  25.     global fonttyp%,zoom%,lines%,h%,w%
  26.     global poff&,ppos%,pcur&,pex%,pgcy%,pcount%
  27.     global toff&,tpos%,tcur&,tex%,tgcy%,tcount%
  28.     global d1%,d2%,d3%,d4%,d5%,d6%,d7%,d8%,d9%,d10%,d11%,d12%,d13%,d14%,d15%
  29.     global w1%,w2%,w3%,w4%,w5%,w6%,w7%,w8%,w9%,w10%,w11%,w12%,w13%,w14%,w15%
  30.  
  31.     Rem  --- Constants ---
  32.     sad&    = 86400 REM Seconds a day (24*60*60)
  33.     maxday& = 86399 REM 23:59:59
  34.     d1970&  = 25567 REM 1/1/1970
  35.     d2038&  = 50422 REM 19/1/2038 - Not 100% correct, but closer than a Pentium ;-)
  36.     mode$   = "T"
  37.  
  38.     diaminit 1,"Time","Project"
  39.     defaultwin 1
  40.     statuswin on,2
  41.     gsetwin 0,0,415,160
  42.     giprint "Note: Worktime is Shareware",0
  43.     SysReq:(cmd$(3),cmd$(2)) rem Open
  44.     giprint "Press Psion-W for more info",0
  45.     Handler:
  46. ENDP
  47.  
  48. Rem Record fields (begin&, end&, norm&,total&,text$) have different meanings
  49. Rem depending on the value of begin& :
  50.  
  51. Rem 0- 99   TSetup&(),PSetup&(),Setup$() values [internal]
  52.  
  53. Rem    0    Old setup, now unused
  54.  
  55. Rem         TSetup&(): - Time mode
  56. Rem    1-7  a.end&=Normal hours
  57. Rem    8-9  a.end&=morning/evening slack
  58. Rem    10   a.end&=Font
  59.  
  60. Rem         PSetup&(): - Project mode
  61. Rem    1-2  a.norm&=Project rounding single
  62. Rem    3-4  a.norm&=Project rounding totals
  63. Rem    5    a.norm&=Automatic project calculation
  64. Rem    6    a.norm&=Normaltime disabled
  65. Rem    10   a.norm&=Font
  66.  
  67. Rem         Setup$():
  68. Rem    1    a.text$=Print output file
  69. Rem    2    a.text$="LOC::M:\*.WTM" (Not implemented)
  70. Rem    3-10 a.text$=Titles for printout (Not implemented)
  71.  
  72. Rem 101-999 Projects / indexes
  73.  
  74. Rem         a.begin&=100+Project number
  75. Rem         a.end&=100 * cost/hour
  76. Rem         a.text$=Project text
  77. Rem         a.norm&=UNUSED
  78. Rem         a.total&=Total time used
  79.  
  80. Rem 1000-   Time slots
  81.  
  82. Rem         a.begin&=Meeting time
  83. Rem         a.end&=Leaving time
  84. Rem         a.text$=Project/entry text
  85. Rem         a.norm&=Normal (estimated) time
  86. Rem         a.total&=Accum. time diff
  87.  
  88.  
  89. PROC SysReq:(act$,file$) REM For system requests
  90.     SaveFile:
  91.     if     act$="X" :stop             REM Close and Exit
  92.     elseif act$="C" :MkFile:(file$)   REM Create new file
  93.     elseif act$="O" :OpenFile:(file$) REM Open file
  94.     endif
  95. ENDP
  96.  
  97. PROC SetFont:(fnt&)
  98.     local i%(32),font%,ws%
  99.     if fnt&
  100.         fonttyp%=int(fnt&/4)*4+1
  101.         zoom%   =fnt&-fonttyp%
  102.     endif
  103.     if fonttyp%<>5 :fonttyp%=9 :endif
  104.     if zoom%<0 or zoom%>3 :zoom%=0 :endif
  105.     font%=fonttyp%+zoom%
  106.     if mode$="T"
  107.         Tsetup&(10)=font%
  108.     else
  109.         Psetup&(10)=font%
  110.     endif
  111.     gfont font%
  112.     font font%,0
  113.     ginfo i%()
  114.     h%=i%(3) rem Font Height
  115.     rem (4)=descent, (5)=ascent
  116.     w%=i%(6) rem Width of '0' character (average width)
  117.     rem (7)=max character width
  118.     lines%=(gheight-8)/h%
  119.     gcmax%=(lines%-1)*h%
  120.     if mode$="T"
  121.         ws%=.5*w%
  122.         w1%=7       :d1%=3.5*w%
  123.         w2%=w1%+d1% :d2%=1.9*w%
  124.         w3%=w2%+d2%+ws% :d3%=3.5*w%
  125.         w4%=w3%+d3%
  126.         w5%=w4%+ws% :d5%=4.5*w%
  127.         w6%=w5%+d5% :d6%=1.5*w%
  128.         w7%=w6%+d6% :d7%=4.5*w%
  129.         w8%=w7%+d7%+ws% :d8%=0.7*w%
  130.         w9%=w8%+d8% :d9%=5.5*w%
  131.         w10%=w9%+d9%+ws%
  132.         w11%=w10%+ws% :d11%=6.5*w%
  133.         w12%=w11%+d11%+ws%
  134.         w14%=gwidth-4
  135.         w13%=w12%+ws% :d13%=w14%-w13%
  136.         off&=Offset&:(cur&,1-lines%) :gcy%=gcmax%
  137.     else
  138.         off&=cur& :gcy%=0
  139.     endif
  140.     Repaint:
  141. ENDP
  142.  
  143. PROC Handler:
  144.     global a%(6)
  145.     while 1
  146.         onerr Error
  147.         getevent a%()
  148.         @(mode$+hex$(a%(1))):
  149.         continue
  150.         Rem This part is only reached when no corresponding event handler is found.
  151.         Rem Keypresses fall back on either TextED: or RecED:
  152.     Error::
  153.         if err=-99
  154.             onerr Error2
  155.             @("A"+hex$(a%(1))):  Rem shared function
  156.             continue
  157.         endif
  158.     Error2::
  159.         if err=-99 and a%(1)<256
  160.             @(mode$+"Default"):
  161.         else
  162.             ShowErr:(hex$(a%(1)))
  163.         endif
  164.     endwh
  165. ENDP
  166.  
  167. PROC TDefault:
  168.     if a%(1)>64 rem Textchars
  169.         TextED:
  170.     elseif a%(1)<256 Rem Other
  171.         RecED:
  172.     else
  173.         ShowErr:(hex$(a%(1)))
  174.     endif
  175. ENDP
  176. PROC PDefault:
  177.     if a%(1)<256 Rem typing char
  178.         ProjED:
  179.     else
  180.         ShowErr:(hex$(a%(1)))
  181.     endif
  182. ENDP
  183.  
  184. PROC MkFile:(reqfile$)
  185.     local file$(128),o%(6)
  186.     o%(1)=1 :o%(2)=6 :o%(3)=8 :o%(4)=8 :o%(5)=10 :o%(6)=0
  187.     file$=parse$(reqfile$,"LOC::M:\*.WTM",o%())
  188.     trap create file$,A,begin&,end&,norm&,total&,text$
  189.     if err
  190.         setname "-none-"
  191.         ShowErr:("Cannot create '"+file$+"'")
  192.         A26d: Rem file requester
  193.         return
  194.     endif
  195.     setname file$
  196.     Defaults:
  197.     SaveSet:
  198.     cur&=Early&:(Now&:) :off&=cur&-lines%*sad& :gcy%=gcmax% :exists%=0
  199.     SetFont:(Tsetup&(10))
  200. ENDP
  201.  
  202. PROC Defaults:
  203.     REM 28800 sec = 8 hours; 18000 = 5hours
  204.     Tsetup&(1)=28800 :Tsetup&(2)=28800 : Tsetup&(3)=28800 :Tsetup&(4)=28800 :Tsetup&(5)=18000 REM Mon-Fri
  205.     Tsetup&(6)=0 :Tsetup&(7)=0 rem Sat-Sun
  206.     Tsetup&(8)=0 :Tsetup&(9)=0 rem Morning/Evening slack
  207.     Tsetup&(10)=9
  208.     Psetup&(1)=0
  209.     Psetup&(2)=0
  210.     Psetup&(3)=0
  211.     Psetup&(4)=0
  212.     Psetup&(5)=0
  213.     Psetup&(6)=1
  214.     Psetup&(10)=9
  215. ENDP
  216.  
  217. PROC OpenFile:(file$)
  218.     local n%,sp%,set$(255),v$(10),sep$(1)
  219.     trap open file$,A,begin&,end&,norm&,total&,text$
  220.     if err
  221.         setname "-none-"
  222.         ShowErr:("Cannot open '"+file$+"'")
  223.         A26f: Rem File requester
  224.         return
  225.     endif
  226.     setname file$
  227.  
  228.     Rem Comment string from first entry holds all the setup values.
  229.     Rem Extract and save as Tsetup&(1-10)
  230.  
  231.     if a.begin&>15
  232.         giprint "Whoa! Resorting needed!" :Sort: :first
  233.         giprint "OK, lets see how it looks now"
  234.     endif
  235.     if a.begin&
  236.         while a.begin&<11 and not eof Rem increase num along with no of setup records
  237.             Tsetup&(a.begin&)=a.End&
  238.             Psetup&(a.begin&)=a.Norm&
  239.             Setup$(a.begin&)=a.Text$
  240.             next
  241.         endwh
  242.         if PSetup&(6)=0 :PSetup&(6)=1 :endif
  243.     else
  244.         Rem All of this is for converting to new format
  245.         giprint "Converting to new file format"
  246.         busy "Converting"
  247.         set$=a.text$
  248.         Rem old setup overrides all setup records and projects !
  249.         first :while not eof and a.begin&<=99 :erase :endwh
  250.         Rem Decide on what seperator was used
  251.         Rem for packing the setup values.
  252.         if loc(set$,chr$(13)) :sep$=chr$(13) :else :sep$=" " :endif
  253.         Defaults:
  254.         n%=1 :sp%=loc(set$,sep$)
  255.         while sp%>0 and n%<=10
  256.             Tsetup&(n%)=val(left$(set$,sp%-1))
  257.             a.begin&=n%
  258.             a.end&=Tsetup&(n%)
  259.             a.norm&=Psetup&(n%)
  260.             a.text$=Setup$(n%)
  261.             append
  262.             if sp%>=len(set$) :break :endif
  263.             set$=right$(set$,len(set$)-sp%)
  264.             n%=n%+1 :sp%=loc(set$,sep$)
  265.         endwh
  266.         if sp%
  267.             set$=left$(set$,sp%-1)+","
  268.             n%=101 :sp%=loc(set$,",")
  269.             while sp%>0
  270.                 a.begin&=n%
  271.                 a.end&=0
  272.                 a.norm&=0
  273.                 a.total&=0
  274.                 a.text$=left$(set$,sp%-1)
  275.                 if a.text$<>"11" :append :endif
  276.                 if sp%>=len(set$) :break :endif
  277.                 set$=right$(set$,len(set$)-sp%)
  278.                 n%=n%+1 :sp%=loc(set$,",")
  279.             endwh
  280.         endif
  281.         busy "Rewriting base"
  282.         first :while a.begin&>999 and not eof :update :giprint num$(a.begin&,15),0 :first :endwh
  283.         busy off
  284.     endif
  285.     if mode$="P" :MovTo:(&101,0) :else :MovTo:(datetosecs(year,month,day,23,59,59),0) :endif
  286.     SetFont:(Tsetup&(10))
  287. ENDP
  288.  
  289. PROC ShowErr:(txt$)
  290.     dinit
  291.     dtext "",txt$,$400
  292.     dtext "",err$(err),$600
  293.     dtext ""," "
  294.     dbuttons "Exit program",%x,"Continue",-13
  295.     lock on
  296.     if dialog=%x :stop :endif
  297.     lock off
  298. ENDP
  299.  
  300. PROC Repaint:
  301.     ggrey 2 :gcls
  302.     @(mode$+"Paint"):(off&,lines%)
  303.     Cursor:
  304. ENDP
  305.  
  306. PROC Cursor:
  307.     gat 1,gcy%+4
  308.     if mode$="T" :ginvert w12%,h% :else :ginvert 400,h% :endif
  309. ENDP
  310.  
  311. PROC Paint:(from&,l%)
  312.     @(mode$+"Paint"):(from&,l%)
  313. ENDP
  314.  
  315. PROC TPaint:(from&,l%)
  316.     local y%,dy%,lin%,ay%
  317.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  318.     local oldcur&,oldpos%,oldex%,oldcurd&
  319.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  320.     gborder $203
  321.     
  322.     TMovTo:(off&,0)
  323.     y%=TMovCnt%:(from&,0)*h%
  324.     dy%  = h%*l%
  325.     ggrey 1
  326.     gat   w4%,y%+4 :glineby 0,dy%
  327.     gat   w8%,y%+4 :glineby 0,dy%
  328.     gat  w10%,y%+4 :glineby 0,dy%
  329.     gat  w12%,y%+4 :glineby 0,dy%
  330.     lin%=l%
  331.     while (lin%>0)
  332.         if cur&=oldcur& :gcy%=y% :endif
  333.         secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
  334.         wd% = dow(da%,mo%,yr%)
  335.         ggrey 1 :gat 1,y%+4
  336.         if wd%=6 or wd%=7
  337.             gfill w12%,h%,0
  338.         else
  339.             glineby w12%,0
  340.         endif
  341.         ggrey 0
  342.         ay%=y%+3+h%
  343.         gat w1%,ay% :gprintb dayname$(wd%),d1%
  344.         gat w2%,ay% :gprintb num$(da%,2),d2%,1
  345.         gat w3%,ay% :gprintb month$(mo%),d3%
  346.         if exists%
  347.             gat w5%,ay% :gprintb Time$:(cur&,0,0),d5%,1
  348.             gat w6%,ay% :gprintb "-",d6%,3
  349.             if a.end&
  350.                 gat  w7%,ay% :gprintb Time$:(a.end&,0,0),d7%,1
  351.                 gat  w9%,ay% :gprintb Time$:(Use&:,1,0),d9%,1
  352.                 gat w11%,ay% :gprintb Time$:(RoundT&:(a.total&),1,0),d11%,1
  353.             endif
  354.             gat w13%,ay% :gprintb a.text$,d13%
  355.         endif
  356.         TMovRel:(1,0)
  357.         y% = y%+h% :lin%=lin%-1
  358.     endwh
  359.     ggrey 1 :gat 1,y%+4 :glineby w13%,0 :ggrey 0
  360.     position oldpos% :cur&=oldcur& :exists%=oldex%
  361. ENDP
  362.  
  363. PROC PPaint:(from&,l%)
  364.     local y%,dy%,lin%
  365.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  366.     local oldcur&,oldpos%,oldex%,oldcurd&
  367.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  368.     gborder $203
  369.     y%=(from&-off&)*h%
  370.     PMovTo:(from&,0)
  371.     dy%  = h%*l%
  372.     ggrey 1
  373.     gat  40,y%+4 :glineby 0,dy%
  374.     gat 190,y%+4 :glineby 0,dy%
  375.     gat 250,y%+4 :glineby 0,dy%
  376.     gat 310,y%+4 :glineby 0,dy%
  377.     lin%=l%
  378.     while (lin%>0)
  379.         if cur&=oldcur& :gcy%=y% :endif
  380.         ggrey 1 :gat 1,y%+4 :glineby 400,0
  381.         ggrey 0
  382.         gat 7,y%+3
  383.         gmove 0,h% :gprintb num$(cur&-100,-3),25,1
  384.         if exists%
  385.             gmove 40,0 :gprintb a.text$,140
  386.             gmove 150,0 :gprintb fix$(a.end&/100.0,2,8),50,1
  387.             gmove  50,0 :gprintb Time$:(RoundT&:(a.total&),1,0),55,1
  388.             gmove  70,0 :gprintb fix$(RoundT&:(a.total&)/3600.0*a.end&/100.0,2,8),40,1
  389. rem            gmove 60,0 :gprintb Time$:(a.norm&,1,0),45,1
  390.         endif
  391.         PMovRel:(1,0)
  392.         y% = y%+h% :lin%=lin%-1
  393.     endwh
  394.     ggrey 1 :gat 1,y%+4 :glineby 400,0 :ggrey 0
  395.     position oldpos% :cur&=oldcur& :exists%=oldex%
  396. ENDP
  397.  
  398. PROC num2$:(n%)
  399.     if n%<10 :return "0"+num$(n%,5) :else :return num$(n%,5) :endif
  400. ENDP
  401.  
  402. PROC Time$:(t&,sign%,secs%)
  403.     local res$(30),yr%,mo%,da%,ho%,mi%,se%,yrd%
  404.     secstodate abs(t&),yr%,mo%,da%,ho%,mi%,se%,yrd%
  405.     if yr%<1972 :ho%=abs(t&)/3600 :endif
  406.     if t&<0      :res$=res$+"-"
  407.     elseif sign% :res$=res$+"+"
  408.     else         :res$=res$+" "
  409.     endif
  410.     res$=res$+num2$:(ho%)+":"+num2$:(mi%)
  411.     if secs% :res$=res$+":"+num2$:(se%) :endif
  412.     return res$
  413. ENDP
  414.  
  415. PROC RecED:
  416.     local m&,l&,n&,c$(63),morn&,even&
  417.     local yr%,mo%,dy%,hr%,mn%,sc%,yd%,wd%
  418.     local ret%,new$(13)
  419.     morn& = Early&:(cur&)
  420.     secstodate cur&,yr%,mo%,dy%,hr%,mn%,sc%,yd%
  421.     wd%=dow(dy%,mo%,yr%)
  422.     Rem See if an entry already exists
  423.     if exists%
  424.         m&=cur&-morn&
  425.         l&=a.end&
  426.         if l& :l&=l&-morn& :endif
  427.         n&=a.norm&
  428.         c$=a.text$
  429.         PAdd:(c$,-Use&:)
  430.         new$=""
  431.     else
  432.         Rem Fill in Defaults
  433.         m&=8*60*60
  434.         n&=Tsetup&(wd%)
  435.         l&=m&+n&
  436.         new$="  (new entry)"
  437.     endif
  438.     Rem   Display edit dialog
  439.     dinit dayname$(wd%)+" "+num$(dy%,2)+" "+month$(mo%)+" "+num$(yr%,4)+new$
  440.     dtime m&,"Begin",1,0,maxday&
  441.     dtime l&,"End",1,0,maxday&
  442.     dtext "Worktime",Time$:(l&-m&,0,1),0
  443.     if PSetup&(6)=1 :dtime n&,"Normal time",0,0,maxday& :else :n&=0 :endif
  444.     dtext "Todays diff",Time$:(RoundS&:(l&-m&-n&),1,1)+" ("+Time$:(l&-m&-n&,1,1)+")",0
  445.     dtext "Total diff",Time$:(RoundT&:(a.total&),1,1)+" ("+Time$:(a.total&,1,1)+")",0
  446.     dedit c$,"Comment",63
  447.     lock on :ret% = dialog :lock off
  448.     if ret%
  449.         a.begin&=m&+morn&
  450.         if l& :l&=l&+morn& :if m&>l& :l&=l&+sad& :endif :endif
  451.         a.end&=l&
  452.         a.norm&=n&
  453.         a.text$=c$
  454.         Insert:(exists%)
  455.     endif
  456.     PAdd:(c$,Use&:)
  457. ENDP
  458.  
  459. PROC ProjED:
  460.     local tot&,rtot&,norm&,cost,ret%,proj$(63),new$(13)
  461.     Rem See if an entry already exists
  462.     if exists%
  463.         dinit "Project "+num$(cur&-100,3)
  464.         proj$=a.text$
  465.         cost=a.end&/100.0
  466.         norm&=a.norm&
  467.         tot&=a.total&
  468.     else
  469.         dinit "Project "+num$(cur&-100,3)+" (New project)"
  470.         proj$=""
  471.         cost=0
  472.         tot&=0
  473.         norm&=0
  474.     endif
  475.     rtot&=RoundT&:(tot&)
  476.     dedit proj$,"Project",20
  477.     dfloat cost,"Cost/hour",0,999999
  478.     dtext "Time spent on project",Time$:(rtot&,1,1)+" ("+Time$:(tot&,1,1)+")",0
  479.     dtext "Total cost",fix$(cost*rtot&/3600.0,2,10)+" ("+fix$(cost*tot&/3600.0,2,10)+")",0
  480.     lock on :ret% = dialog :lock off
  481.     if ret%
  482.         a.begin&=cur&
  483.         a.text$=proj$
  484.         a.norm&=norm&
  485.         a.total&=tot&
  486.         a.end&=100.0*cost
  487.         Insert:(exists%)
  488.     endif
  489. ENDP
  490.  
  491. PROC RoundS&:(tim&) Rem Round single timing entry
  492.     if PSetup&(1)<2 or PSetup&(2)=0 Rem No rounding
  493.         return tim&
  494.     elseif PSetup&(1)=2 Rem UP
  495.         return int(.9999+tim&*1.0/PSetup&(2))*PSetup&(2)
  496.     elseif PSetup&(1)=3 Rem Down
  497.         return int(tim&/PSetup&(2))*PSetup&(2)
  498.     elseif PSetup&(1)=4 Rem Nearest
  499.         return int(.5+tim&*1.0/PSetup&(2))*PSetup&(2)
  500.     endif
  501. ENDP
  502.  
  503. PROC RoundT&:(tim&) Rem Round Total times
  504.     if PSetup&(3)<2 or PSetup&(4)=0 Rem No rounding
  505.         return tim&
  506.     elseif PSetup&(3)=2 Rem UP
  507.         return int(.9999+tim&*1.0/PSetup&(4))*PSetup&(4)
  508.     elseif PSetup&(3)=3 Rem Down
  509.         return int(tim&/PSetup&(4))*PSetup&(4)
  510.     elseif PSetup&(3)=4 Rem Nearest
  511.         return int(.5+tim&*1.0/PSetup&(4))*PSetup&(4)
  512.     endif
  513. ENDP
  514.  
  515. PROC TextED:
  516.     local c$(63), ret%
  517.     if exists%
  518.         c$=a.text$
  519.     else
  520.         a.begin&=Early&:(cur&)+Now&:-Early&:(Now&:)
  521.         a.norm&=0
  522.         a.end&=0
  523.         c$=chr$(a%(1))
  524.     endif
  525.     dinit "Comment"
  526.     dedit c$,"",63
  527.     REM So how do I position the cursor to the end of the 'dedit' string ?
  528.     REM If you have an idea please tell me...
  529.     lock on :ret% = dialog :lock off
  530.     if ret%
  531.         a.text$=c$
  532.         Insert:(exists%)
  533.     endif
  534. ENDP
  535.  
  536. PROC SaveFile:
  537.     PCflush:
  538.     trap close
  539.     if err<>0 and err<>-102
  540.         ShowErr:("Error closing file")
  541.     endif
  542. ENDP
  543.  
  544. PROC PaintCur:
  545.     Cursor:
  546.     @(mode$+"Paint"):(cur&,1)
  547.     Cursor:
  548. ENDP
  549.  
  550. Rem current entry is always the one just less than or eual to cur&
  551. Rem exists% tells if rec really exists
  552.  
  553. PROC MovCurs:(d%)
  554.     local rd%
  555.     if abs(d%)>lines%
  556.         if d%>0
  557.             off&=Offset&:(cur&,1-lines%) :gcy%=gcmax%
  558.         else
  559.             off&=cur& :gcy%=0
  560.         endif
  561.         Repaint:
  562.         return
  563.     endif
  564.     Cursor:
  565.     gcy%=gcy%+d%*h%
  566.     if gcy%<0  rem Move UP (scrolls down)
  567.         rd% = gcy%/h%
  568.         off&=cur&
  569.         ggrey 2 :gscroll 0,-rd%*h%,1,4,411,gcmax% :ggrey 0
  570.         @(mode$+"Paint"):(off&,-rd%)
  571.         gcy% = 0
  572.     elseif gcy%>gcmax%  rem Move DOWN (scrolls up)
  573.         rd% = (gcy%-gcmax%)/h%
  574.         off& = Offset&:(off&,rd%)
  575.         ggrey 2 :gscroll 0,-rd%*h%,1,4+h%,411,gcmax% :ggrey 0
  576.         @(mode$+"Paint"):(Offset&:(off&,lines%-rd%),rd%)
  577.         gcy%=gcmax%
  578.     endif
  579.     Cursor:
  580. ENDP
  581.  
  582. Rem Move to Entry specified as time&
  583. Rem cur& will point to
  584. Rem 1) Entry, if exists
  585. Rem 2) Prev entry same day, if any
  586. Rem 3) Following entry same day, if any
  587. Rem 4) Start of day (exists%=0)
  588.  
  589. PROC MovTo:(time&,show%)
  590.  @(mode$+"MovTo"):(time&,show%)
  591. ENDP
  592.  
  593. PROC PMovTo:(pnum&,show%)
  594.     local origcur&,lin%
  595.     origcur&=cur&
  596.     cur&=pnum&
  597.     while a.begin&<pnum& and not eof :next :endwh
  598.     if eof :back :endif
  599.     while a.begin&>pnum& and not eof :back :endwh
  600.     exists%=a.begin&=cur&
  601.     if show% :lin%=cur&-origcur& :MovCurs:(lin%) :endif
  602. ENDP
  603.  
  604. PROC TMovTo:(time&,show%)
  605.     local day&,lin%,d&
  606.     d&=int(time&/sad&)-int(cur&/sad&)
  607.     if abs(d&)<50 and show%
  608.         lin%=d&
  609.         while a.begin&<time& and not eof
  610.             next
  611.             if int(a.begin&/sad&)=int(cur&/sad&) :lin%=lin%+1 :endif
  612.             cur&=a.begin&
  613.         endwh
  614.         if eof :back :endif
  615.         while a.begin&>time& and not eof
  616.             back
  617.             if int(a.begin&/sad&)=int(cur&/sad&) :lin%=lin%-1 :endif
  618.             cur&=a.begin&
  619.         endwh
  620.     else
  621.         REM - Fast seek
  622.         if time&>cur& :lin%=50 :else :lin%=-50 :endif
  623.         while a.begin&<time& and not eof :next :endwh
  624.         if eof :back :endif
  625.         while a.begin&>time& and not eof :back :endwh
  626.     endif
  627.     day&=Early&:(time&)
  628.     exists%=1 Rem High probability
  629.     if a.begin&=time&
  630.         cur&=time&
  631.     elseif a.begin&>=day& and a.begin&<day&+sad&
  632.         cur&=a.begin&
  633.     else
  634.         next
  635.         if not eof and a.begin&>=day& and a.begin&<day&+sad&
  636.             cur&=a.begin&
  637.         else
  638.             back :cur&=day& :exists%=0
  639.         endif
  640.     endif
  641.     if show% :MovCurs:(lin%) :endif
  642. ENDP
  643.  
  644.  
  645. PROC MovRel:(lin%,show%)
  646.  @(mode$+"MovRel"):(lin%,show%)
  647. ENDP
  648.  
  649. PROC PMovRel:(lines%,show%)
  650.     local new&
  651.     new&=max(min(cur&+lines%,999),101)
  652.     PMovTo:(new&,show%)
  653. ENDP
  654.  
  655. PROC TMovRel:(lin%,show%)
  656.     local l%,day&
  657.     l%=lin%
  658.     while l%<0 Rem go back
  659.         if exists% :back :endif
  660.         day&=Early&:(cur&)-sad& Rem Yesterday
  661.         if a.begin&<day&
  662.             cur&=day& :exists%=0
  663.         else
  664.             cur&=a.begin& :exists%=1
  665.         endif
  666.         l%=l%+1
  667.     endwh
  668.     while l%>0
  669.         next
  670.         day&=Early&:(cur&)+sad& Rem Tomorrow
  671.         if eof
  672.             back
  673.             cur&=day& :exists%=0
  674.         elseif a.begin&>=day&+sad& Rem after the morning of the day after tomorrow
  675.             back
  676.             cur&=day& :exists%=0
  677.         else
  678.             cur&=a.begin& :exists%=1
  679.         endif
  680.         l%=l%-1
  681.     endwh
  682.     if show% :MovCurs:(lin%) :endif
  683. ENDP
  684.  
  685. PROC TMovCnt%:(time&,show%)
  686.     local lin%
  687.     while cur&<time& :MovRel:( 1,show%) :lin%=lin%+1 :endwh
  688.     while cur&>time& :MovRel:(-1,show%) :lin%=lin%-1 :endwh
  689.     if show% :MovCurs:(lin%) :endif
  690.     return lin%
  691. ENDP
  692.  
  693. PROC Insert:(upd%)
  694.     local p%,np%,b&,scroll%
  695.     b&=a.begin&
  696.     if upd%
  697.         update
  698.         scroll%=0
  699.     else
  700.         p%=pos
  701.         append :np%=pos
  702.         position p%
  703.         if b&<a.begin&
  704.             scroll%=-1    Rem Perhaps this should really scroll top half screen up (split) or bottom half down
  705.         else
  706.             scroll%=1
  707.         endif
  708.     endif
  709.     last
  710.     
  711.     Reorder:
  712.     MovTo:(b&,1)
  713.     
  714.     if scroll% and gcy%<gcmax%
  715.         Repaint:
  716.     else
  717.         PaintCur:
  718.     endif
  719. ENDP
  720.  
  721. PROC Reorder:
  722.     local p%,begin&,total&,cnt%
  723.     rem We know that only last rec can be out of order
  724.     busy "Sorting..."
  725.     onerr Error
  726.     last :begin&=a.begin&
  727.     back
  728.     while a.begin&>begin& :cnt%=cnt%+1 :back :endwh
  729.     
  730.     Rem Erase duplicates
  731.     while a.begin&=begin& and cnt% :erase :back :endwh
  732.     if a.begin&>999 :total&=a.total& :else :total&=0 :endif
  733.     next :p%=pos
  734.     last
  735.     if a.begin&>999
  736.         if a.end&<>0 :total&=total&+Use&: :endif :a.total&=total&
  737.         update :Rem still remains at end
  738.     endif
  739.     while cnt%
  740.         position p%
  741.         if a.begin&>999
  742.             if a.end& :total&=total&+Use&: :endif :a.total&=total&
  743.         endif
  744.         update :Rem Move to end (after new rec)
  745.         cnt%=cnt%-1
  746.     endwh
  747.     goto Done
  748. Error::
  749.     ShowErr:("Problem while sorting")
  750. Done::
  751.     busy off
  752.     MovTo:(cur&,0)
  753. ENDP
  754.  
  755. PROC Offset&:(from&,lin%)
  756.     local oldcur&,oldpos%,oldex%,oldcurd&
  757.     local offs&
  758.     if mode$="P" :return from&+lin% :endif
  759.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  760.     MovTo:(from&,0)
  761.     MovRel:(lin%,0)
  762.     offs&=cur&
  763.     position oldpos% :cur&=oldcur& :exists%=oldex%
  764.     return offs&
  765. ENDP
  766.  
  767. PROC Now&:
  768.     return datetosecs(year,month,day,hour,minute,second)
  769. ENDP
  770.  
  771. PROC Early&:(tim&)
  772.     return int(tim&/sad&)*sad&
  773. ENDP
  774.  
  775.  
  776. PROC A8: rem Delete
  777.     DelCur:
  778. ENDP
  779.  
  780. PROC T7f: rem shift-delete (backspace)
  781.     DelRang:
  782. ENDP
  783.  
  784. PROC DelCur:
  785.     local stat%,oldcur&
  786.     if exists%
  787.         oldcur&=cur&
  788.         dinit
  789.         dtext "","Remove"
  790.         dbuttons "Yes",%y,"No",%n
  791.         lock on : stat%=dialog :lock off
  792.         if stat%=%y
  793.             CopyBuf: :PAdd:(a.text$,-Use&:)
  794.             ERASE
  795.             MovTo:(oldcur&,1)
  796.             Repaint: Rem sometimes, we could do with less
  797.             giprint "Removed"
  798.         endif
  799.     else
  800.         giprint "Nothing to remove"
  801.     endif
  802. ENDP
  803.  
  804. PROC DelRang:
  805.     local stat%,from&,to&,cnt%,oldcur&
  806.     oldcur&=cur&
  807.     from&=cur&/sad&+d1970&
  808.     to&=cur&/sad&+1+d1970&
  809.     dinit
  810.     dtext "","Remove"
  811.     ddate from&,"from",d1970&,d2038&
  812.     ddate to&,"to (excl.)",d1970&,d2038&
  813.     dbuttons "Yes",%y,"No",%n
  814.     lock on : stat%=dialog :lock off
  815.     if stat%=%y
  816.         busy "Removing"
  817.         from&=(from&-d1970&)*sad&
  818.         to&=(to&-d1970&)*sad&
  819.         first
  820.         while a.begin&<from& and not eof :next :endwh
  821.         while a.begin&<to& and not eof
  822.             cnt%=cnt%+1
  823.             REM This is silly, when removing a range
  824.             REM only last entry is remembered
  825.             REM But to remember all takes up way too much memory (does it, really ?)
  826.             CopyBuf:
  827.             ERASE
  828.         endwh
  829.         if cnt%
  830.             MovTo:(oldcur&,1)
  831.             Repaint:
  832.             giprint num$(cnt%,5)+" entries removed"
  833.         else
  834.             giprint "No entries removed"
  835.         endif
  836.         busy off
  837.     endif
  838. ENDP
  839.  
  840. PROC DelPRang:
  841. ENDP
  842.  
  843. PROC CopyBuf:
  844.     onerr Problem::
  845.     rem Copy to paste buffer
  846.     bbegin&=a.begin&
  847.     bend&=a.end&
  848.     bnorm&=a.norm&
  849.     btext$=a.text$
  850. Problem::
  851. ENDP
  852.  
  853. PROC P9: rem TAB
  854.     JumpProj:
  855. ENDP
  856. PROC T9: rem TAB
  857.     JumpDate:
  858. ENDP
  859.  
  860. PROC Td: rem ENTER
  861.     RecED:
  862. ENDP
  863.  
  864. PROC A1b: rem ESC
  865.     call($198d,100,0)  Rem background
  866. ENDP
  867.  
  868. PROC T20: rem Space
  869.     local wd%,tim&
  870.     if exists% and cur&>999 and a.end&=0
  871.         tim&=cur&
  872.     else
  873.         tim&=Now&:
  874.         MovTo:(tim&,1)
  875.     endif
  876.     if exists% and a.end&=0
  877.         a.end&=Now&:+Tsetup&(9)
  878.         PAdd:(a.text$,Use&:)
  879.         Insert:(exists%)
  880.     else
  881.         if cur&>tim& :MovCurs:(1) :endif
  882.         a.begin&=tim&-Tsetup&(8)
  883.         a.end&=0
  884.         a.norm&=0 :if PSetup&(6)=1 :wd%=dow(day,month,year) :a.norm&=Tsetup&(wd%) :endif
  885.         a.text$=""
  886.         Insert:(0)
  887.     endif
  888. ENDP
  889.  
  890. PROC P20: rem Space
  891.     if exists% :else :ProED: :endif
  892.     if exists% :ProStart:(a.text$) :endif
  893. ENDP
  894.  
  895. PROC A100: rem up
  896.     if a%(2) and 2  rem Shift
  897.         MovRel:(-3,1)
  898.     elseif a%(2) and 4  rem Control
  899.         if mode$="T"
  900.             MovTo:(cur&-30*sad&,1)
  901.         else
  902.             MovRel:(-30,1)
  903.         endif
  904.     else
  905.         MovRel:(-1,1)
  906.     endif
  907. ENDP
  908.  
  909. PROC A101: rem down
  910.     if a%(2) and 2  rem Shift
  911.         MovRel:(3,1)
  912.     elseif a%(2) and 4  rem Control
  913.         if mode$="T"
  914.             MovTo:(cur&+30*sad&,1)
  915.         else
  916.             MovRel:(30,1)
  917.         endif
  918.     else
  919.         MovRel:(1,1)
  920.     endif
  921. ENDP
  922.  
  923. PROC T102: rem right
  924.  TextED:
  925. ENDP
  926. PROC P102: rem right
  927.  ProjED:
  928. ENDP
  929. PROC P103: rem left
  930.  ProjED:
  931. ENDP
  932. PROC T103: rem left
  933.  RecED:
  934. ENDP
  935.  
  936. PROC A104: rem Page up
  937.     MovRel:(-10,1)
  938. ENDP
  939.  
  940. PROC A105: rem Page down
  941.     MovRel:(10,1)
  942. ENDP
  943.  
  944. rem PROC T106: rem Page right
  945. rem ENDP
  946. rem PROC T107: rem Page left
  947. rem ENDP
  948.  
  949. PROC A122: rem Menu
  950.     local menu%
  951.     onerr Error
  952.     minit
  953.     rem a(b)cdDef[gh]ij[k]lmnopqrs[t](u)[v]wx[y]z
  954.     mcard "File","Open file",%o,"Make new file",%m,"Print",%p,"Who did this?",%w,"Exit",%x
  955.     mcard "Edit","Insert",%i,"Copy",%c,"Delete",%D,"Delete range",%R,"Edit",%e
  956.     mcard "Screen","Repaint",%r,"Sort/Recalc",%s,"Jump to date",%j,"Font type",%f,"Zoom in",%z,"Zoom out",%Z
  957.     mcard "Project","Begin",%b,"Project Usage",%u,"Tally/Recalc projects",%t
  958.     mcard "Settings","Normal worktime",%n,"Slack",%l,"Rounding",%q,"Auto Calculation",%a
  959.     lock on :menu% = MENU :lock off
  960.     if menu%
  961.         @(mode$+hex$(menu%+$200)):
  962.     endif
  963.     return
  964. Error::
  965.     if err=-99
  966.         onerr Error2
  967.         @("A"+hex$(menu%+$200)):
  968.         return
  969.     endif
  970. Error2::
  971.     ShowErr:(hex$(menu%+$200))
  972. ENDP
  973.  
  974. PROC A123: rem Help
  975.     local file$(20)
  976.     file$="\opo\Workhelp.opo"
  977.     trap loadm file$
  978.     if err
  979.         ShowErr:("'"+file$+"' - Help not installed")
  980.     else
  981.         WorkHelp:
  982.         unloadm file$
  983.     endif
  984. ENDP
  985.  
  986. PROC T124: rem Star/diamond
  987.     ToPMode:
  988. ENDP
  989. PROC P124: rem Star/diamond
  990.     ToTMode:
  991. ENDP
  992.  
  993. PROC ToPMode:
  994.     tpos%=pos :tcur&=cur& :toff&=off& :tex%=exists% :tgcy%=gcy% :tcount%=count
  995.     PCflush:
  996.     mode$="P"
  997.     diampos 2
  998.     if pcount%=count
  999.         position ppos% :cur&=pcur& :off&=poff& :exists%=pex% :gcy%=pgcy%
  1000.     else
  1001.         first
  1002.         while not eof and a.begin&<101 :next :endwh
  1003.         if not eof and a.begin&>100 and a.begin&<=999
  1004.             exists%=1 :cur&=a.begin&
  1005.         else
  1006.             exists%=0 :cur&=101
  1007.         endif
  1008.         off&=cur& :gcy%=0
  1009.     endif
  1010.     SetFont:(Psetup&(10))
  1011. ENDP
  1012.  
  1013. PROC ToTMode:
  1014.     ppos%=pos :pcur&=cur& :poff&=off& :pex%=exists% :pgcy%=gcy% :pcount%=count
  1015.     mode$="T"
  1016.     diampos 1
  1017.     cur&=tcur& :off&=toff& :exists%=tex% :gcy%=tgcy%
  1018.     if count=tcount%
  1019.         position tpos%
  1020.     else
  1021.         MovTo:(cur&,0)
  1022.     endif
  1023.     SetFont:(Tsetup&(10))
  1024. ENDP
  1025.  
  1026. PROC A244:
  1027.     DelCur:
  1028. ENDP
  1029.  
  1030. PROC T252:
  1031.     DelRang:
  1032. ENDP
  1033. PROC P252:
  1034.     giprint "Not implemented yet, sorry"
  1035. ENDP
  1036.  
  1037. PROC A261: rem psion-a = Automatic project calc
  1038.     local stat%,apc%
  1039.     apc%=PSetup&(5)+1
  1040.     dinit "Automatic project calculation"
  1041.     dchoice apc%,"Auto calc","Off,On"
  1042.     lock on :stat%=dialog :lock off
  1043.     if stat%
  1044.         PSetup&(5)=apc%-1
  1045.         SaveSet:
  1046.     endif
  1047. ENDP
  1048.  
  1049. PROC T262: rem psion-b = Begin project
  1050.     T124: Rem move to project mode
  1051.     giprint "Move cursor to project and press SPACE"
  1052.     return
  1053. ENDP
  1054.  
  1055. PROC ProStart:(proj$) rem Start project
  1056.     local wd%,tim&,today&
  1057.     if mode$<>"T" :ToTMode: :endif Rem Shift to time mode
  1058.     tim&=Now&:
  1059.     MovTo:(tim&,1)
  1060.     today&=Early&:(tim&)
  1061.     if exists% and a.end&=0 and a.begin&>today& and a.begin&<today&+sad&
  1062.         if a.norm& :a.end&=Now&:+Tsetup&(9) :else a.end&=Now&: :endif
  1063.         Insert:(exists%)
  1064.     endif
  1065.     a.begin&=tim&
  1066.     a.end&=0
  1067.     a.norm&=0  Rem Projects won't use this
  1068.     a.text$=proj$
  1069.     insert:(0)
  1070. ENDP
  1071.  
  1072. PROC A263: rem psion-c = Copy
  1073.     if exists%
  1074.         CopyBuf:
  1075.         giprint "Copied"
  1076.     else
  1077.         giprint "Nothing to Copy"
  1078.     endif
  1079. ENDP
  1080.  
  1081. PROC A264: rem psion-d = Delete Project/Entry
  1082.     DelCur:
  1083. ENDP
  1084.  
  1085. PROC T265: rem psion-e = Edit
  1086.     RecED:
  1087. ENDP
  1088. PROC P265: rem psion-e = Edit
  1089.     ProjED:
  1090. ENDP
  1091.  
  1092. PROC A266: rem psion-f = Font type
  1093.     local stat%,typ%
  1094.     if fonttyp%=5 :typ%=1 :else :typ%=2 :endif
  1095.     dinit "Font type"
  1096.     dchoice typ%,"","Roman,Swiss"
  1097.     lock on :stat%=dialog :lock off
  1098.     if stat%
  1099.         if typ%=1 :fonttyp%=5 :else fonttyp%=9 :endif
  1100.         SetFont:(&0) :REM ***TODO*** int(0)
  1101.         SaveSet:
  1102.     endif
  1103. ENDP
  1104.  
  1105. PROC T269: rem psion-i = Insert
  1106.     if bbegin&>999
  1107.         a.begin&=bbegin&-Early&:(bbegin&)+Early&:(cur&)
  1108.         if bend& :a.end&=bend&-Early&:(bend&)+Early&:(cur&) :else :a.end&=0 :endif
  1109.         a.norm&=bnorm&
  1110.         a.text$=btext$
  1111.         Insert:(0)
  1112.         PAdd:(btext$,Use&:)
  1113.     else
  1114.         giprint "Nothing to insert"
  1115.     endif
  1116. ENDP
  1117. PROC P269: rem psion-i = Insert
  1118.     if bbegin&>100 and bbegin&<=999
  1119.         a.begin&=cur&
  1120.         a.end&=bend&
  1121.         a.norm&=bnorm&
  1122.         a.text$=btext$
  1123.         Insert:(0)
  1124.     else
  1125.         giprint "Nothing to insert"
  1126.     endif
  1127. ENDP
  1128.  
  1129. PROC T26a: rem psion-j = Jump to date
  1130.     JumpDate:
  1131. ENDP
  1132. PROC P26a: rem psion-j = Jump to project
  1133.     JumpProj:
  1134. ENDP
  1135.  
  1136. PROC JumpDate:
  1137.     local to&,ret%
  1138.     to&=days(day,month,year)
  1139.     dinit "Jump to date"
  1140.     ddate to&,"",d1970&,d2038&
  1141.     lock on :ret% = dialog :lock off
  1142.     if ret%
  1143.         Rem point to last entry of the day
  1144.         MovTo:((to&-d1970&+1)*sad&-1,1)
  1145.     endif
  1146. ENDP
  1147. PROC JumpProj:
  1148.     local to&,ret%
  1149.     to&=cur&-100
  1150.     dinit "Jump to project"
  1151.     dlong to&,"",&1,&899
  1152.     REM Later: also search for text
  1153.     lock on :ret% = dialog :lock off
  1154.     if ret% :MovTo:(to&+100,1) :endif
  1155. ENDP
  1156.  
  1157. PROC A26c: rem psion-l = Slack
  1158.     dinit "Slack setup"
  1159.     dtime Tsetup&(8),"Begin",1,0,datetosecs(1970,1,1,0,59,59)
  1160.     dtime Tsetup&(9),"End",1,0,datetosecs(1970,1,1,0,59,59)
  1161.     lock on :if dialog :SaveSet: :endif :lock off
  1162. ENDP
  1163.  
  1164. PROC A26d: rem psion-m = Make new
  1165.     local file$(128),ret%
  1166.     dinit "Make new file"
  1167.     dfile file$,"",$9
  1168.     lock on :ret% = dialog :lock off
  1169.     if ret%
  1170.         SaveFile:
  1171.         MkFile:(file$)
  1172.     endif
  1173. ENDP
  1174.  
  1175. PROC A26e: rem psion-n = Normal worktime
  1176.     local n%, enab%
  1177.     dinit "Normal worktime"
  1178.     enab%=PSetup&(6)
  1179.     dchoice enab%,"Enabled", "Yes,No"
  1180.     n%=1
  1181.     while n%<=7
  1182.         dtime Tsetup&(n%),dayname$(n%),1,0,maxday&
  1183.         n%=n%+1
  1184.     endwh
  1185.     lock on :if dialog :PSetup&(6)=enab% :SaveSet: :endif :lock off
  1186. ENDP
  1187.  
  1188. PROC SaveSet:
  1189.     local n%,p%
  1190.     p%=pos
  1191.     busy "Saving setup"
  1192.     Rem Remove old setup records
  1193.     first :while a.begin&<100 and not eof :p%=p%-1 :ERASE :first :endwh
  1194.     n%=1
  1195.     while n%<=10
  1196.         a.begin&=n%
  1197.         a.end&=Tsetup&(n%)
  1198.         a.norm&=Psetup&(n%)
  1199.         a.text$=Setup$(n%)
  1200.         append
  1201.         n%=n%+1 :p%=p%+1
  1202.     endwh
  1203.     first
  1204.     while a.begin&>100 and not eof :update :first :endwh
  1205.     busy off
  1206.     giprint "Saved"
  1207.     position p%
  1208. ENDP
  1209.  
  1210. PROC A26f: rem psion-o = Open/Load
  1211.     local file$(128),ret%
  1212.     dinit "Open file"
  1213.     dfile file$,"",$10
  1214.     lock on
  1215.     if dialog
  1216.         SaveFile:
  1217.         OpenFile:(file$)
  1218.     endif
  1219.     lock off
  1220. ENDP
  1221.  
  1222. PROC T270: rem psion-p Print
  1223.     local stat%,from&,to&,showsec%,showsel%,showby%
  1224.     local file$(128)
  1225.  
  1226.     file$=Setup$(1)
  1227.     if file$="" :file$="LOC::M:\Time.out" :endif
  1228.     showsel%=2
  1229.     dinit "Print to file"
  1230.     from&=days(1,month,year)
  1231.     if month<12 :to&=days(1,month+1,year) :else :to&=days(1,1,year+1) :endif
  1232.     ddate from&,"from",d1970&,d2038&
  1233.     ddate to&,"to (excl.)",d1970&,d2038&
  1234.     dchoice showby%,"Grouped","No,by month,by week,by day"
  1235.     dchoice showsel%,"Show","Entries only,Entries & Totals,Totals only"
  1236.     dchoice showsec%,"Show seconds","No,Yes"
  1237.     dfile file$,"File",1
  1238.     lock on :stat% = dialog :lock off
  1239.     if stat%=0 :return :endif
  1240.  
  1241.     if Setup$(1)<>file$ :Setup$(1)=file$ :SaveSet: :endif
  1242.     from&=(from&-d1970&)*sad&
  1243.     to&=(to&-d1970&)*sad&
  1244.     
  1245.     LOpen file$
  1246.     busy "Printing"
  1247.     
  1248.     PrintIt:(from&,to&,showby%,showsel%,showsec%-1)
  1249.     
  1250.     busy off
  1251.     lclose
  1252. ENDP
  1253. PROC P270:
  1254.     giprint "Project Printing not implemented, sorry."
  1255. ENDP
  1256.  
  1257. PROC PrintIt:(from&,to&,showby%,showsel%,showsec%)
  1258.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  1259.     local p%,pcnt%,proj$(30,63),ptot&(30),pbyx&(30)
  1260.     local by%,newby%
  1261.     local transf&,projlen%
  1262.     local oldcur&,oldpos%,oldex%,oldcurd&
  1263.     
  1264.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  1265.     
  1266.     MovTo:(from&,0)
  1267.     if showsel%<3
  1268.         if exists% :back :transf&=a.total& :next :else :transf&=a.total& :endif
  1269.         lprint "Transfer";rept$(" ",45+12*showsec%)+Time$:(transf&,1,showsec%)
  1270.     endif
  1271.     while (cur& < to&)
  1272.         secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
  1273.         if showby%>1
  1274.             if showby%=2  Rem by Month
  1275.                 newby%=mo%
  1276.             elseif showby%=3  Rem by Week
  1277.                 newby%=week(da%,mo%,yr%)
  1278.             elseif showby%=4  Rem by Day
  1279.                 newby%=int(cur&/sad&)
  1280.             endif
  1281.             if newby%<>by% and pcnt%>0 and by%>0
  1282.                 lprint
  1283.                 if showby%=2  Rem by Month
  1284.                     lprint "Month totals (";month$(by%);")"
  1285.                 elseif showby%=3  Rem by Week
  1286.                     lprint "Week totals (week ";by%;")"
  1287.                 elseif showby%=4  Rem by Day
  1288.                     secstodate sad&*by%,yr%,mo%,da%,ho%,m%,s%,yrd%
  1289.                     wd% = dow(da%,mo%,yr%)
  1290.                     lprint "Day totals ";dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%)
  1291.                     secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
  1292.                 endif
  1293.                 p%=1 :projlen%=projlen%+2
  1294.                 while p%<=pcnt%
  1295.                     if pbyx&(p%) :lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(pbyx&(p%),0,showsec%) :pbyx&(p%)=0 :endif
  1296.                     p%=p%+1
  1297.                 endwh
  1298.                 lprint
  1299.             endif
  1300.             by%=newby%
  1301.         endif
  1302.         wd% = dow(da%,mo%,yr%)
  1303.         if showsel%<3 :lprint dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%); :endif
  1304.         if exists%
  1305.             if showsel%<3 :lprint "  ";Time$:(cur&,0,showsec%);" -"; :endif
  1306.             if a.end&
  1307.                 if showsel%<3 :lprint " ";Time$:(a.end&,0,showsec%);"  ";Time$:(PUse&:,0,showsec%); :if PSetup&(6)=1 :lprint " ";Time$:(a.norm&,0,0); :endif :lprint "  ";Time$:(Use&:,1,showsec%);"  ";Time$:(RoundT&:(a.total&),1,showsec%); :endif
  1308.                 transf&=a.total&
  1309.                 if a.text$<>""
  1310.                     if showsel%<3 :lprint "   ";a.text$; :endif
  1311.                     if showsel%>1
  1312.                         p%=1 :while p%<=pcnt% and proj$(p%)<>a.text$ :p%=p%+1 :endwh
  1313.                         if proj$(p%)<>a.text$ and pcnt%<30
  1314.                             pcnt%=pcnt%+1
  1315.                             proj$(pcnt%)=a.text$ :p%=pcnt%
  1316.                             projlen%=max(projlen%,len(a.text$))
  1317.                         endif
  1318.                         ptot&(p%)=ptot&(p%)+PUse&:
  1319.                         pbyx&(p%)=pbyx&(p%)+PUse&:
  1320.                     endif
  1321.                 endif
  1322.             elseif a.text$<>"" and showsel%<3
  1323.                 lprint rept$(" ",38+12*showsec%);a.text$;
  1324.             endif
  1325.         endif
  1326.         if showsel%<3 :lprint :endif
  1327.         MovRel:(1,0)
  1328.     endwh
  1329.     if showsel%<3 :lprint "Transfer";rept$(" ",45+12*showsec%)+Time$:(transf&,1,showsec%) :endif
  1330.     if pcnt%
  1331.         if showby%>1 and by%>0
  1332.             lprint
  1333.             if showby%=2  Rem by Month
  1334.                 lprint "Month totals (";month$(by%);")"
  1335.             elseif showby%=3  Rem by Week
  1336.                 lprint "Week totals (week ";by%;")"
  1337.             elseif showby%=4  Rem by Day
  1338.                 secstodate sad&*by%,yr%,mo%,da%,ho%,m%,s%,yrd%
  1339.                 wd% = dow(da%,mo%,yr%)
  1340.                 lprint "Day totals ";dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%)
  1341.                 secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
  1342.             endif
  1343.             p%=1 :projlen%=projlen%+2
  1344.             while p%<=pcnt%
  1345.                 if pbyx&(p%) :lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(pbyx&(p%),0,showsec%) :pbyx&(p%)=0 :endif
  1346.                 p%=p%+1
  1347.             endwh
  1348.         endif
  1349.         lprint :lprint "Project totals:"
  1350.         p%=1 :projlen%=projlen%+2
  1351.         while p%<=pcnt%
  1352.             lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(ptot&(p%),0,showsec%)
  1353.             p%=p%+1
  1354.         endwh
  1355.     endif
  1356.     position oldpos% :cur&=oldcur& :exists%=oldex%
  1357. ENDP
  1358.  
  1359. PROC A271:  rem psion-q - Rounding
  1360.     local r1%,r2%
  1361.     if Psetup&(1) :r1%=Psetup&(1) :else :r1%=1 :endif
  1362.     if Psetup&(3) :r2%=Psetup&(3) :else :r2%=1 :endif
  1363.     dinit "Rounding"
  1364.     dtext "","On Entries",$102
  1365.     dchoice r1%,"Direction","No rounding,Up,Down,Nearest"
  1366.     dtime Psetup&(2),"Time",1,0,maxday&
  1367.     dtext "","On Totals",$102
  1368.     dchoice r2%,"Direction","No rounding,Up,Down,Nearest"
  1369.     dtime Psetup&(4),"Time",1,0,maxday&
  1370.     lock on
  1371.     if dialog
  1372.         Psetup&(1)=r1%
  1373.         Psetup&(3)=r2%
  1374.         SaveSet:
  1375.     endif
  1376.     lock off
  1377. ENDP
  1378.  
  1379. PROC P272:  rem psion-r - Repaint
  1380.     Repaint:
  1381. ENDP
  1382. PROC T272:  rem psion-r - Repaint
  1383.     if a%(2) and 2  rem Shift
  1384.         DelRang:
  1385.     else
  1386.         Repaint:
  1387.     endif
  1388. ENDP
  1389.  
  1390. PROC Sort:
  1391.     local remain%,us%,i%,j%,prev&,e&,total&,lo%,hi%,po%
  1392.     local v&(251),p%(251)
  1393.     if count=0 :return :endif
  1394.     busy "Sorting..."
  1395.     onerr error::
  1396.     remain%=count
  1397.     while remain%
  1398.         first :us%=1 :v&(us%)=a.begin& :p%(us%)=pos :next
  1399.         if pos<remain%
  1400.             while pos<=remain%
  1401. giprint num$(pos,3),0
  1402.                 e&=a.begin&
  1403.                 if (e&>v&(us%)) and (us%>=250) :next :continue :endif
  1404.                 lo%=1 :hi%=us%+1
  1405.                 while lo%<hi% :i%=(lo%+hi%)/2 :if e&<v&(i%) :hi%=i% :else :lo%=i%+1 :endif :endwh
  1406.                 i%=us% :while i%>=lo% :v&(i%+1)=v&(i%) :p%(i%+1)=p%(i%) :i%=i%-1 :endwh
  1407.                 v&(lo%)=e& :p%(lo%)=pos
  1408.                 if us%<250 :us%=us%+1 :endif
  1409.                 next
  1410.             endwh
  1411.         endif
  1412.         i%=1
  1413.         while i%<=us%
  1414.             position p%(i%)
  1415.             e&=a.begin& :while e&<>v&(i%) :giprint "Index mismatch "+num$(i%,5)+" = "+num$(e&,15) :pause -50 :back :e&=a.begin& :endwh
  1416. giprint num$(e&,15),0
  1417.             if e&=prev& :giprint "Duplicate removed "+num$(e&,15) :erase
  1418.             elseif e&>999 :if a.end& :total&=total&+Use&: :endif :a.total&=total& :update
  1419.             elseif e&>100 :a.total&=0 :update
  1420.             else
  1421.                 update
  1422.             endif
  1423.             prev&=e&
  1424.             po%=p%(i%) :j%=i%+1 :while j%<=us% :if p%(j%)>po% :p%(j%)=p%(j%)-1 :endif :j%=j%+1 :endwh
  1425.             i%=i%+1
  1426.         endwh
  1427.         remain%=remain%-us%
  1428.     endwh
  1429.     busy off
  1430.     if cur& :MovTo:(cur&,0) :endif
  1431.     giprint num$(count-1,5)+" entries sorted"
  1432.     return
  1433. Error::
  1434.     ShowErr:("Error while sorting - rec will be deleted")
  1435.     erase
  1436.     Sort:
  1437. ENDP
  1438.  
  1439. PROC Tally: rem "Daaaoo, we say daaaoo..."
  1440.     local e&,i%,oldpon%,d&
  1441.     oldpon%=PSetup&(5) :PSetup&(5)=1
  1442.     busy "Tallying projects"  rem  Or is it bananas....
  1443.     PCClear:
  1444.     first
  1445.     while not eof
  1446.         e&=a.begin&
  1447.         if e&>100 and e&<=999 :d&=-a.total&
  1448.         elseif e&<=999 or a.text$="" or a.end&=0 :next :continue
  1449.         else d&=Use&: :endif
  1450.         i%=pos :PAdd:(a.text$,d&) :position i% :while a.begin&<=e& and not eof :next :endwh
  1451.     endwh
  1452.     busy off
  1453.     if mode$="P" :PCFlush: :Repaint: :PMovTo:(cur&,0): endif
  1454.     PSetup&(5)=oldpon%
  1455. ENDP
  1456.  
  1457. PROC A273: rem psion-s = Sort/Recalc
  1458.     Sort:
  1459.     first :MovTo:(cur&,0)
  1460.     Repaint:
  1461. ENDP
  1462.  
  1463. PROC A274: rem psion-T = Tally projects
  1464.     Tally:
  1465. ENDP
  1466.  
  1467. PROC A275:  Rem Psion-U Project Usage
  1468.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  1469.     local p%,po%,pcnt%,lin$(255),proj$(30,63),ptot&(30)
  1470.     local oldcur&,oldpos%,oldex%,oldcurd&
  1471.     local stat%,from&,to&,showsec%
  1472.     showsec%=2
  1473.     dinit "Project Usage"
  1474.     from&=days(1,month,year)
  1475.     if month<12 :to&=days(1,month+1,year) :else :to&=days(1,1,year+1) :endif
  1476.     ddate from&,"from",d1970&,d2038&
  1477.     ddate to&,"to (excl.)",d1970&,d2038&
  1478.     dchoice showsec%,"Show secs","No,Yes"
  1479.     lock on :stat% = dialog :lock off
  1480.     if stat%=0 or from&>to& :return :endif
  1481.     from&=(from&-d1970&)*sad&
  1482.     to&=(to&-d1970&)*sad&
  1483.     showsec%=showsec%-1
  1484.     REM Calc
  1485.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  1486.     busy "Calculating"
  1487.     MovTo:(from&,0)
  1488.     if not exists% :next :endif
  1489.     while a.begin&<to& and not eof
  1490.         if a.end& and a.text$<>""
  1491.             p%=1 :while p%<=pcnt% and proj$(p%)<>a.text$ :p%=p%+1 :endwh
  1492.             if proj$(p%)<>a.text$ and pcnt%<30
  1493.                 pcnt%=pcnt%+1 :proj$(pcnt%)=a.text$ :p%=pcnt%
  1494.             endif
  1495.             ptot&(p%)=ptot&(p%)+PUse&:
  1496.         endif
  1497.         next
  1498.     endwh
  1499.     busy off
  1500.     if pcnt%
  1501.         po%=1
  1502.         while 1
  1503.             dinit "Project totals"
  1504.             p%=po%
  1505.             while p%<po%+5 and p%<=pcnt%
  1506.                 dtext proj$(p%),Time$:(ptot&(p%),0,showsec%),1
  1507.                 p%=p%+1
  1508.             endwh
  1509.             if pcnt%<8
  1510.             elseif po%<2       :dbuttons "Down",&101
  1511.             elseif po%>pcnt%-5 :dbuttons "Up",&100
  1512.             else               :dbuttons "Up",&100,"Down",&101
  1513.             endif
  1514.             lock on :stat% = dialog :lock off
  1515.             if         stat%=&100 :po%=po%-1
  1516.             elseif stat%=&101 :po%=po%+1
  1517.             else
  1518.                 break
  1519.             endif
  1520.         endwh
  1521.     else
  1522.         giprint "No projects found"
  1523.     endif
  1524.     position oldpos% :cur&=oldcur& :exists%=oldex%
  1525. ENDP
  1526.  
  1527.  
  1528. PROC A277: rem psion-w = Who created this ? (whoinfo)
  1529.     lock on
  1530.     dinit "Worktime"
  1531.     dtext "","Version 2.76",2
  1532.     dtext "","Created Dec 1994 - Mar 1996",2
  1533.     dtext "","by",2
  1534.     dtext "","Erik Johansen",$102
  1535.     dtext "","ej@it.dtu.dk",$102
  1536.     dtext "","(icon by ja@it.dtu.dk)",2
  1537.     dialog
  1538.     dinit "Worktime is Shareware"
  1539.     dtext "","If you have decided to keep and use Worktime",2
  1540.     dtext "","please send me $15 as shareware fee.",2
  1541.     dtext ""," "
  1542.     dtext "","Include your Name and E-mail address,",2
  1543.     dtext "","and I will mail future updates to you.",2
  1544.     dialog
  1545.     dinit "So where do I send the money?"
  1546.     dtext "","Send $15 (or the same amount"
  1547.     dtext "","in your local currency)",2
  1548.     dtext ""," "
  1549.     dtext "","Erik Johansen",$102
  1550.     dtext "","Syriensvej 9A",$102
  1551.     dtext "","2300 Copenhagen S.",$102
  1552.     dtext "","Denmark",$102
  1553.     dialog
  1554.     lock off
  1555. ENDP
  1556.  
  1557. PROC A278: rem psion-x = Exit
  1558.     SaveFile: :stop
  1559. ENDP
  1560.  
  1561. PROC A25a: rem shift-psion-Z (from menu) = Zoom out
  1562.     zoom%=zoom%-1 :if zoom%<0 :zoom%=3 :endif
  1563.     SetFont:(&0) :SaveSet:
  1564. ENDP
  1565.  
  1566. PROC A27a: rem psion-z = Zoom
  1567.     if a%(2) and 2  rem Shift
  1568.         zoom%=zoom%-1 :if zoom%<0 :zoom%=3 :endif
  1569.     else
  1570.         zoom%=zoom%+1 :if zoom%>3 :zoom%=0 :endif
  1571.     endif
  1572.     SetFont:(&0) :SaveSet:
  1573. ENDP
  1574.  
  1575. PROC A401: rem Foreground
  1576. ENDP
  1577.  
  1578. PROC A402: rem Background
  1579. ENDP
  1580.  
  1581. Rem Add 'call($6c8d)' at start of program to enable powe-on signals
  1582. PROC A403: rem Powerup
  1583. ENDP
  1584.  
  1585. PROC A404: rem sys request
  1586.     local c$(129)
  1587.     c$ = getcmd$
  1588.     SysReq:(left$(c$,1),mid$(c$,2,128))
  1589. ENDP
  1590.  
  1591. PROC T405: rem Date change
  1592.     MovTo:(Now&:,1)
  1593. ENDP
  1594. PROC P405: rem Date change - ignored in project mode
  1595. ENDP
  1596.  
  1597. PROC A2000: rem + contrast
  1598. ENDP
  1599.  
  1600. PROC A2001: rem - contrast
  1601. ENDP
  1602.  
  1603. PROC Use&:
  1604.     return RoundS&:(a.end&-a.begin&-a.norm&)
  1605. ENDP
  1606. PROC PUse&:
  1607.     return RoundS&:(a.end&-a.begin&)
  1608. ENDP
  1609.  
  1610. PROC PAdd:(text$, time&)
  1611.     local n%
  1612.     if PSetup&(5)=0 or text$="" :return :endif
  1613.     n%=20
  1614.     while n%
  1615.         if PCtext$(n%)=text$
  1616.             PCdiff&(n%)=PCdiff&(n%)+time&
  1617.             return
  1618.         elseif PCtext$(n%)="" or PCdiff&(n%)=0
  1619.             PCtext$(n%)=text$
  1620.             PCdiff&(n%)=time&
  1621.             return
  1622.         endif
  1623.         n%=n%-1
  1624.     endwh
  1625.     PCFlush:
  1626.     n%=20
  1627.     PCtext$(n%)=text$
  1628.     PCdiff&(n%)=time&
  1629. ENDP
  1630.  
  1631. PROC PCClear:
  1632.     local n%
  1633.     n%=20 :while n%>0 :PCdiff&(n%)=0 :PCtext$(n%)="" :n%=n%-1 :endwh
  1634. ENDP
  1635.  
  1636. PROC PCFlush:
  1637.     local oldcur&,n%,las&,c%
  1638.     if PSetup&(5)=0 :return :endif rem Return if auto update not enabled
  1639.     
  1640.     Rem Check if anything in cache, otherwise return
  1641.     n%=20
  1642.     while n%>0
  1643.         if PCdiff&(n%)<>0 and PCtext$(n%)<>"" :n%=-1 :endif
  1644.         n%=n%-1
  1645.     endwh
  1646.     if n%=0 :return :endif
  1647.     
  1648.     busy "Updating Projects"
  1649.     c%=count
  1650.     oldcur&=a.begin&
  1651.     first
  1652.     while c%>0 and a.begin&<101 :update :first :c%=c%-1 :endwh
  1653.     las&=100
  1654.     while c%>0 and a.begin&<=999
  1655.         las&=a.begin&
  1656.         n%=20
  1657.         while n%
  1658.             if PCtext$(n%)=a.text$
  1659.                 a.total&=a.total&+PCdiff&(n%)
  1660.                 PCtext$(n%)=""
  1661.                 PCdiff&(n%)=0
  1662.             endif
  1663.             n%=n%-1
  1664.         endwh
  1665.         update :first :c%=c%-1
  1666.     endwh
  1667.     
  1668.     n%=20
  1669.     while n%
  1670.         if PCtext$(n%)<>"" and PCdiff&(n%)<>0
  1671.             las&=las&+1
  1672.             if las&>998
  1673.                 giprint "Too many projects"
  1674.             else
  1675.                 a.begin&=las&
  1676.                 a.end&=0
  1677.                 a.norm&=0
  1678.                 a.text$=PCtext$(n%)
  1679.                 a.total&=PCdiff&(n%)
  1680.                 append
  1681.             endif
  1682.             PCtext$(n%)=""
  1683.             PCdiff&(n%)=0
  1684.         endif
  1685.         n%=n%-1
  1686.     endwh
  1687.     busy "Updating"
  1688.     first
  1689.     while c%>0
  1690. giprint num$(a.begin&,15),0
  1691.         update :first :c%=c%-1
  1692.     endwh
  1693.     busy off
  1694. ENDP
  1695.  
  1696. REM ===== Project keys =====
  1697.  
  1698. Rem Procedure name is constructed like this:
  1699. Rem ("T" Time mode, "P" project mode or "A" any) + hexadecimal key value
  1700.  
  1701. PROC T6c: REM 'l'-key
  1702.     ProStart:("Lunch")
  1703. ENDP
  1704.  
  1705. PROC T6d: REM 'm'-key
  1706.     ProStart:("Meeting")
  1707. ENDP
  1708.  
  1709. PROC T74: REM 't'-key
  1710.     ProStart:("Transport")
  1711. ENDP
  1712.  
  1713. PROC T77: REM 'w'-key
  1714.     ProStart:("Work")
  1715. ENDP
  1716.  
  1717. Rem --------------------------------
  1718.  
  1719.